﻿/// /////////////////////////////////////////////
// 单元名 : unitSyncObj
// 作者 : Hawk
// 单元描述 :
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit unitSyncObj;

interface

uses
  {$IFNDEF FPC}
  Windows,
  {$ELSE}
  FileUtil,
  {$ENDIF}
  SysUtils, unitDDLinkList, unitCommonDataStruct, unitMisc, unitIOCPDataObj, unitCommonTypes, unitClassIDDef;

type
  TSyncOperator = (soNone, soUpload, soDownload, soDelete);

  TOLD_REC = packed record
    ModTime: TCommonFILETIME;
    FileSize: TFILE_SIZE;
    SyncErr: ERRCODE;
    RetryCount: longword;
  end;

  TSyncFile = class(TSerialObj)
  private
    FFileSize: TFILE_SIZE;
    FSyncErr: ERRCODE;
    FRetryCount: longword;
    FModTime: longword;
    FSyncOperator: TSyncOperator;
    function GetFileName: CommonString;
    procedure SetFileName(const Value: CommonString);
    procedure SetModTime(const Value: longword);
    procedure SetFileSize(const Value: TFILE_SIZE);
    procedure SetSyncErr(const Value: ERRCODE);
    procedure SetRetryCount(const Value: longword);
  protected
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoClone(Target: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
  public
    class function ClassID: longword; override;
    procedure Return; override;
    procedure ResetModFile;

    property FileName: CommonString read GetFileName write SetFileName;
    property ModTime: longword read FModTime write SetModTime;
    property FileSize: TFILE_SIZE read FFileSize write SetFileSize;
    property SyncOperator: TSyncOperator read FSyncOperator write FSyncOperator;
    property SyncErr: ERRCODE read FSyncErr write SetSyncErr;
    property RetryCount: longword read FRetryCount write SetRetryCount;
  end;

  TSearchParam = class(TSerialObj)
  private
    FSearchPath: CommonString;
    FExtNames, FExPaths: TCommStrArr;
    FFlags: longword;

    function GetExPath(Index: integer): CommonString;
    function GetExtName(Index: integer): CommonString;
    procedure SetSearchPath(const Value: CommonString);
  protected
    procedure DoClone(Target: TSerialObj); override;
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
  public
    class function ClassID: longword; override;
    procedure Return; override;

    function CheckFlag(Mask: longword): boolean;
    procedure AddExtName(s: CommonString);
    procedure AddExPath(s: CommonString);
    procedure DelExtName(idx: integer);
    procedure DelExPath(idx: integer);
    procedure SetFlag(Mask: longword);
    procedure ReSetFlag(Mask: longword);
    procedure Clear;

    property SearchPath: CommonString read FSearchPath write SetSearchPath;
    property ExtName[Index: integer]: CommonString read GetExtName;
    property ExPath[Index: integer]: CommonString read GetExPath;
    property Flags: longword read FFlags;
  end;

  TSyncPath = TStringObj;

  TOnSearchComplete = procedure(Sender: TObject; Result: TSyncPath) of object;

  TSyncStaticInfo = class(TSerialObj)
  private
    FLastUploadCount: longword;
    FDownloadSize: int64;
    FLastDownloadSize: int64;
    FUploadSize: int64;
    FLastUploadSize: int64;
    FDownloadFilesCount: longword;
    FUploadFilesCount: longword;
    FLastDownloadCount: longword;
    FNewItemCount: longword;
  public
    class function ClassID: longword; override;
    procedure Return; override;

    property UploadFilesCount: longword read FUploadFilesCount write FUploadFilesCount;
    property DownloadFilesCount: longword read FDownloadFilesCount write FDownloadFilesCount;
    property UploadSize: int64 read FUploadSize write FUploadSize;
    property DownloadSize: int64 read FDownloadSize write FDownloadSize;
    property NewItemCount: longword read FNewItemCount write FNewItemCount;
    property LastUploadCount: longword read FLastUploadCount write FLastUploadCount;
    property LastDownloadCount: longword read FLastDownloadCount write FLastDownloadCount;
    property LastUploadSize: int64 read FLastUploadSize write FLastUploadSize;
    property LastDownloadSize: int64 read FLastDownloadSize write FLastDownloadSize;
  end;

  TSearchThread = class(TThread)
  private
    FSearchParam: TSearchParam;
    FBusy: Bool;
    FOnSearchComplete: TOnSearchComplete;
    FFileSizeLimit: longword;
    function CheckExPath(s: CommonString): longbool;
    function CheckExtName(s: CommonString): longbool;
    procedure CheckSearchParam(sp: TSerialObj);
    procedure EnumPath(path: CommonString; ro: TStringObj);
    procedure SetSearchParam(sp: TSearchParam);
    procedure SetFileSizeLimit(const Value: longword);
    procedure CalcStaticInfo(ss: TSyncStaticInfo; path: TSyncPath);
  protected
    procedure Execute; override;
  public
    procedure Reset; override;
    property Busy: Bool read FBusy;
    property SearchParam: TSearchParam read FSearchParam write SetSearchParam;
    property FileSizeLimit: longword read FFileSizeLimit write SetFileSizeLimit;
    property OnSearchComplete: TOnSearchComplete read FOnSearchComplete write FOnSearchComplete;
  end;

  TSyncItem = TStoreList;

const
  SPFLAG_WAITENUM = 1;
  SPFLAG_INENUM = 2;
  SPFLAG_WAITFORSYNC = 4;
  SPFLAG_INUPDATE = 8;
  L_FILESIZELIMIT = 5 * 1024 * 1024;
  S_SYNCOPE: array [TSyncOperator] of CommonString = ('None', 'Uoload', 'Download', 'Delete');

function FindEntryInPathByName(path: TSerialObj; Name: CommonString; ClsID: longword = CLASSID_STRINGOBJ): TSerialObj;

implementation

uses unitObjPool, unitErrCodeDef;

function FindEntryInPathByName(path: TSerialObj; Name: CommonString; ClsID: longword): TSerialObj;
begin
  Result := TSerialObj(path.Item[0]);
  while Result <> nil do
  begin
    if (Result.ClassID = ClsID) and (Result.Caption = Name) then
      Break;
    Result := TSerialObj(Result.Next);
  end;
end;

{ TSyncFile }

class function TSyncFile.ClassID: longword;
begin
  Result := CLASSID_SYNC_FILE;
end;

procedure TSyncFile.DoAssign(Source: TSerialObj);
var
  src: TSyncFile absolute Source;
begin
  inherited;
  FModTime := src.FModTime;
  FFileSize := src.FFileSize;
  FSyncErr := src.FSyncErr;
  FRetryCount := src.FRetryCount;
end;

procedure TSyncFile.DoClone(Target: TSerialObj);
var
  tgt: TSyncFile absolute Target;
begin
  inherited;
  tgt.FModTime := FModTime;
  tgt.FFileSize := FFileSize;
  tgt.FSyncErr := FSyncErr;
  tgt.FRetryCount := FRetryCount;
end;

procedure TSyncFile.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
var
  old: TOLD_REC;
begin
  case PropertyIdx of
    // 1:
    // begin
    // Buf.ReadBuf(old, Len);
    // FModTime := FileTimeToFileDate(old.ModTime);
    // FFileSize := old.FileSize;
    // FSyncErr := old.SyncErr;
    // FRetryCount := old.RetryCount;
    // end;
    2:
      Buf.ReadBuf(FFileSize, Len);
    else
      inherited;
  end;
end;

procedure TSyncFile.DoWritePropertyToPack(dp: TIOCPDataCollecter);
// var
// old: TOLD_REC;
begin
  // old.ModTime := FiledateToFileTime(FModTime);
  // old.FileSize := FFileSize;
  // old.SyncErr := FSyncErr;
  // old.RetryCount := FRetryCount;
  // WritePropertyToPack(dp, 1, SizeOf(FFileSize) + SizeOf(ERRCODE) + SizeOf(FRetryCount) + SizeOf(FModTime), old);
  WritePropertyToPack(dp, 2, SizeOf(FFileSize) + SizeOf(ERRCODE) + SizeOf(FRetryCount) + SizeOf(FModTime), FFileSize);
  inherited;
end;

function TSyncFile.GetFileName: CommonString;
begin
  Result := Caption;
end;

procedure TSyncFile.ResetModFile;
begin
  FModTime := 0;
end;

procedure TSyncFile.Return;
begin
  inherited;
  FSyncOperator := soNone;
  FModTime := 0;
  FFileSize.fp64 := 0;
  FSyncErr := ERRCODE_NOERROR;
  FRetryCount := 0;
end;

procedure TSyncFile.SetFileName(const Value: CommonString);
begin
  Caption := Value;
end;

procedure TSyncFile.SetFileSize(const Value: TFILE_SIZE);
begin
  if FFileSize.fp64 <> Value.fp64 then
  begin
    FFileSize := Value;
    DoModifyed;
  end;
end;

procedure TSyncFile.SetModTime(const Value: longword);
begin
  if (FModTime <> Value) then
  begin
    FModTime := Value;
    DoModifyed;
  end;
end;

procedure TSyncFile.SetRetryCount(const Value: longword);
begin
  if FRetryCount <> Value then
  begin
    FRetryCount := Value;
    DoModifyed;
  end;
end;

procedure TSyncFile.SetSyncErr(const Value: ERRCODE);
begin
  if FSyncErr <> Value then
  begin
    FSyncErr := Value;
    DoModifyed;
  end;
end;

{ TSearchParam }

procedure TSearchParam.AddExPath(s: CommonString);
begin
  s := LowerCase(Trim(s));
  if (s <> '') and (StrIndex(FExPaths, s) = -1) then
    AddStrToArr(FExPaths, s);
end;

procedure TSearchParam.AddExtName(s: CommonString);
begin
  s := LowerCase(Trim(s));
  if (s <> '') then
  begin
    if s[1] = '.' then
      Delete(s, 1, 1);
    if (StrIndex(FExtNames, s) = -1) then
      AddStrToArr(FExtNames, s);
  end;
end;

function TSearchParam.CheckFlag(Mask: longword): boolean;
begin
  Result := FFlags and Mask <> 0;
end;

class function TSearchParam.ClassID: longword;
begin
  Result := CLASSID_SEARCHPARAM;
end;

procedure TSearchParam.Clear;
begin
  FSearchPath := '';
  ;
  SetLength(FExtNames, 0);
  SetLength(FExPaths, 0);
  DoModifyed;
end;

procedure TSearchParam.DelExPath(idx: integer);
begin
  DelStrFromArr(FExPaths, idx);
end;

procedure TSearchParam.DelExtName(idx: integer);
begin
  DelStrFromArr(FExtNames, idx);
end;

procedure TSearchParam.DoAssign(Source: TSerialObj);
var
  src: TSearchParam absolute Source;
begin
  inherited;
  FSearchPath := src.FSearchPath;
  FExtNames := CopyStrArr(src.FExtNames);
  FExPaths := CopyStrArr(src.FExPaths);
end;

procedure TSearchParam.DoClone(Target: TSerialObj);
var
  tgt: TSearchParam absolute Target;
begin
  inherited;
  tgt.FSearchPath := FSearchPath;
  tgt.FExtNames := CopyStrArr(FExtNames);
  tgt.FExPaths := CopyStrArr(FExPaths);
end;

procedure TSearchParam.DoReadFromPack(PropertyIdx, Len: longword; Buf: TIOCPDataCollecter);
var
  s: CommonString;
begin
  case PropertyIdx of
    4:
      ReadCommonStringFromPack(Buf, FSearchPath, Len);
    5:
    begin
      ReadCommonStringFromPack(Buf, s, Len);
      AddStrToArr(FExtNames, s);
    end;
    6:
    begin
      ReadCommonStringFromPack(Buf, s, Len);
      AddStrToArr(FExPaths, s);
    end;
    else
      inherited;
  end;
end;

procedure TSearchParam.DoWritePropertyToPack(dp: TIOCPDataCollecter);
var
  i: integer;
begin
  inherited;
  WriteCommonStringToPack(dp, 4, FSearchPath);
  for i := Low(FExtNames) to High(FExtNames) do
    WriteCommonStringToPack(dp, 5, FExtNames[i]);
  for i := Low(FExPaths) to High(FExPaths) do
    WriteCommonStringToPack(dp, 6, FExPaths[i]);
end;

function TSearchParam.GetExPath(Index: integer): CommonString;
begin
  if (index >= 0) and (index < length(FExPaths)) then
    Result := FExPaths[index]
  else
    Result := '';
end;

function TSearchParam.GetExtName(Index: integer): CommonString;
begin
  if (index >= 0) and (index < length(FExtNames)) then
    Result := FExtNames[index]
  else
    Result := '';
end;

procedure TSearchParam.ReSetFlag(Mask: longword);
begin
  Mask := not Mask;
  FFlags := FFlags and Mask;
end;

procedure TSearchParam.Return;
begin
  inherited;
  Clear;
end;

procedure TSearchParam.SetFlag(Mask: longword);
begin
  FFlags := FFlags or Mask;
end;

procedure TSearchParam.SetSearchPath(const Value: CommonString);
begin
  if FSearchPath <> Value then
  begin
    FSearchPath := Value;
    DoModifyed;
  end;
end;

{ TSearchThread }

procedure TSearchThread.CalcStaticInfo(ss: TSyncStaticInfo; path: TSyncPath);
var
  tmp: TSerialObj;
  sf: TSyncFile absolute tmp;
  sp: TSyncPath absolute tmp;
begin
  tmp := TSerialObj(path.Item[0]);
  while tmp <> nil do
  begin
    if tmp.ObjID.IsEmpty then
      Inc(ss.FNewItemCount);
    case tmp.ClassID of
      CLASSID_SYNC_FILE:
        case sf.SyncOperator of
          soUpload:
          begin
            Inc(ss.FUploadFilesCount);
            Inc(ss.FUploadSize, sf.FileSize.fp64);
          end;
          soDownload:
          begin
            Inc(ss.FDownloadFilesCount);
            Inc(ss.FDownloadSize, sf.FileSize.fp64);
          end;
        end;
      CLASSID_STRINGOBJ:
        CalcStaticInfo(ss, sp);
    end;
    tmp := TSerialObj(tmp.Next);
  end;
end;

function TSearchThread.CheckExPath(s: CommonString): longbool;
var
  i: integer;
  ss: CommonString;
begin
  Result := (s <> '.') and (s <> '..');
  if Result and (FSearchParam <> nil) then
  begin
    {$IFDEF MSWINDOWS}
    s := LowerCase(s);
    {$ENDIF}
    i := 0;
    while i < length(FSearchParam.FExPaths) do
    begin
      {$IFDEF MSWINDOWS}
      ss := LowerCase(FSearchParam.FExPaths[i]);
      {$ELSE}
      ss := FSearchParam.FExPaths[i];
      {$ENDIF}
      Result := ss <> s;
      if not Result then
        Break;
      Inc(i);
    end;
  end;
end;

function TSearchThread.CheckExtName(s: CommonString): longbool;
var
  i: integer;
  ss: CommonString;
begin
  Result := False;
  if FSearchParam <> nil then
  begin
    s := ExtractFileExt(s);
    Delete(s, 1, 1);
    {$IFDEF MSWINDOWS}
    s := LowerCase(s);
    {$ENDIF}
    i := 0;
    while i < length(FSearchParam.FExtNames) do
    begin
      {$IFDEF MSWINDOWS}
      ss := LowerCase(FSearchParam.FExtNames[i]);
      {$ELSE}
      ss := FSearchParam.FExtNames[i];
      {$ENDIF}
      if ss = s then
      begin
        Result := True;
        Break;
      end;
      Inc(i);
    end;
  end;
end;

procedure TSearchThread.CheckSearchParam(sp: TSerialObj);
var
  tmp, tt: TSerialObj;
begin
  tmp := TSerialObj(sp.Item[0]);
  while tmp <> nil do
  begin
    tt := TSerialObj(tmp.Next);
    case tmp.ClassID of
      CLASSID_STRINGOBJ:
        if not CheckExPath(tmp.Caption) then
          ObjPool.ReturnObj(tmp, Self)
        else
          CheckSearchParam(tmp);
      CLASSID_SYNC_FILE:
        if not CheckExtName(tmp.Caption) then
          ObjPool.ReturnObj(tmp, Self);
    end;
    tmp := tt;
  end;
end;

procedure TSearchThread.EnumPath(path: CommonString; ro: TStringObj);
var
  sr: TSearchRec;
  sf: TSyncFile;
  sp: TSerialObj absolute sf;
  mt: longword;
  fs: TFILE_SIZE;
begin
  if (path <> '') and (path[length(path)] <> PathDelim) then
    path := path + PathDelim;
  if FindFirst(path + '*.*', faAnyFile, sr) = 0 then
  begin
    while FindNext(sr) = 0 do
    begin
      if (sr.Attr and faDirectory <> 0) then
      begin
        if CheckExPath(sr.Name) then
        begin
          sp := FindEntryInPathByName(ro, sr.Name, TSyncPath.ClassID);
          if sp = nil then
          begin
            sp := ObjPool.GetObj(TSyncPath, Self);
            sp.Caption := sr.Name;
            ro.AddObj(sp);
          end;
          EnumPath(path + sr.Name, TSyncPath(sp));
        end;
      end
      else if CheckExtName(sr.Name) then
      begin
        fs := GetFileSize(path + sr.Name);
        if fs.fp64 <= FFileSizeLimit then
        begin
          sp := FindEntryInPathByName(ro, sr.Name, TSyncFile.ClassID);
          if sf = nil then
          begin
            sf := ObjPool.GetObj(TSyncFile, Self);
            sf.FileName := sr.Name;
            ro.AddObj(sf);
          end;
          mt := GetFileModifyDate(path + sr.Name);
          sf.FileSize := fs;
          case FileDateComp(sf.FModTime, mt) of
            -1:
              sf.SyncOperator := soUpload;
            0:
              sf.SyncOperator := soNone;
            1:
              sf.SyncOperator := soDownload;
          end;
        end;
      end;
    end;
    FindClose(sr);
  end;
end;

procedure TSearchThread.Execute;
var
  sp: TSyncPath;
  ss: TSyncStaticInfo;
begin
  if FSearchParam <> nil then
  begin
    FBusy := True;
    sp := nil;
    if FSearchParam.SearchPath <> '' then
    begin
      DbgPrint('Start search in path %s(%s)', [FSearchParam.SearchPath, FSearchParam.ObjID.ToString]);
      ObjPool.ReturnObj(FSearchParam.Param(TSyncStaticInfo), Self);
      FSearchParam.ReSetFlag(SPFLAG_WAITENUM);
      FSearchParam.SetFlag(SPFLAG_INENUM);
      sp := FSearchParam.Param(TSyncPath);
      if sp = nil then
      begin
        sp := ObjPool.GetObj(TSyncPath, Self);
        FSearchParam.AddObj(sp);
      end;
      sp.Caption := FSearchParam.SearchPath;
      CheckSearchParam(sp);
      EnumPath(FSearchParam.SearchPath, sp);
      ss := ObjPool.GetObj(TSyncStaticInfo, Self);
      CalcStaticInfo(ss, sp);
      FSearchParam.AddObj(ss);
      FSearchParam.ReSetFlag(SPFLAG_INENUM);
      if (ss.FUploadFilesCount <> 0) or (ss.FDownloadFilesCount <> 0) or (ss.FNewItemCount <> 0) then
        FSearchParam.SetFlag(SPFLAG_INUPDATE);
    end;
    FBusy := False;
    FSearchParam := nil;
    if Assigned(FOnSearchComplete) then
      FOnSearchComplete(Self, sp);
  end;
end;

procedure TSearchThread.Reset;
begin
  inherited;
  FFileSizeLimit := L_FILESIZELIMIT;
end;

procedure TSearchThread.SetFileSizeLimit(const Value: longword);
begin
  if Value < L_FILESIZELIMIT then
    FFileSizeLimit := L_FILESIZELIMIT
  else
    FFileSizeLimit := Value;
end;

procedure TSearchThread.SetSearchParam(sp: TSearchParam);
begin
  if not FBusy then
    FSearchParam := sp;
end;

{ TSyncStaticInfo }

class function TSyncStaticInfo.ClassID: longword;
begin
  Result := CLASSID_SYNC_STATICINFO;
end;

procedure TSyncStaticInfo.Return;
begin
  inherited;
  FLastUploadCount := 0;
  FDownloadSize := 0;
  FLastDownloadSize := 0;
  FUploadSize := 0;
  FLastUploadSize := 0;
  FDownloadFilesCount := 0;
  FUploadFilesCount := 0;
  FLastDownloadCount := 0;
end;

initialization

  // DbgPrint(L_DBGLEVEL_DEBUG, 'Enter unitSyncObj init');
  ObjPool.RegisterObjClass(TSyncFile);
  ObjPool.RegisterObjClass(TSearchParam);
  ObjPool.RegisterObjClass(TSyncStaticInfo);
  // DbgPrint(L_DBGLEVEL_DEBUG, 'Enter unitSyncObj init');

end.
